Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Libraries/SAT 2.1.2/Collision ⁄⁄⁄ ƒ/Collision ⁄⁄⁄.p

Text File | 1994-07-02 | 34.2 KB | 1,231 lines | [TEXT/PJMM]

{Collision ///}
{}
{This demo demonstrates some alternative ways to use SAT:}
{}
{• The animation is called from the standard event loop (via TransSkel). This slows things down}
{quite a bit (since all other processes are allowed to run), but makes the application background-}
{friendly.}
{• It runs in an ordinary, moveable window. We can, with some effort, do this while still}
{using the fast mode (in which case we would have to restrict window dragging so it stays}
{within the main screen, modify certain global (gSAT.ox ad gSAT.oy), and also limit the}
{horizontal alignment of the window like HyperCard does), but in this demo we just use the}
{slow (safe) mode. }
{• We create sprites from QuickDraw calls instead of cicns.}
{• We use the mask regions of the sprites for better collision detection.}
{• We use a pattern as backkground instead of PICTs.}
{• All the code is in one unit. This might make it less structured, less encapsulated, but I wanted}
{to show you that you don't have to do things exactly the way I do in the other demos.}
{• Using a modified sprite record.}
{• Fixed-point positions}
{}
{However, some variations remain that aren't demonstrated even here:}
{• Calculating the positions of the sprites with the system clock (TickCount or Time Manager) instead of}
{moving them each frame. That approach has some advantages (i.e. constant speed on objects), can easily}
{be used with SAT, but is not as simple.}


program CollisionIII;

    uses
        TransSkel, SAT;

    const
        newgameItem = 1;
        clearHighItem = 3;

        aboutAlrt = 128;
        fileMenuRes = 128;
        shapeMenuRes = 129;
        theWindRes = 128;

        kGameTime = 3600; {60 sekunder}
        kExtraTime = 180; {3 sekunder}
        kLevelBonus = 25;

    type
        SettingsRec = record
                high: Longint;
                player: string[5];
            end;
        SettingsPtr = ^SettingsRec;
        SettingsHnd = ^SettingsPtr;
    var
        settings: SettingsHnd;
        fileMenu, shapeMenu: MenuHandle;
        gameRunning: Boolean;
        gameStartTime, lastSetStartTime: Longint;
        setCount: integer;
        gMode: integer;
        scoreFace, highFace, lastface: FacePtr;
        myFace, welcomeFace: FacePtr;
        score: Longint;
        bgPat: SATPatHandle;

        scaledFace: array[0..31] of FacePtr;

    procedure Barf;
    begin
        ReportStr('Something went wrong. Sorry.');
        halt;
    end;

{Ljud:}

{Konstruera en snd-resurs artificiellt}
{Rutinen bygger en handle med reserverad plats för ljudet, som sedan värdrutinen kan skapa.}
    function CreateSnd (size: longint; var sndH: handle; var dataPek: Ptr): Boolean;
        type
            mySndRec = packed record
                    format: integer;
                    numsynth: integer; {must be 0}
{synth}
                    synthid: integer;{5}
                    synthinit: longint;{0}

                    numcom: integer; {must be 1}
{command}
                    command: integer;{ $8051}
                    param1: integer; {0}
                    param2: longint; { $14}
{sound header}
                    dataptr: Ptr;
                    datasize: longint;
                    samplerate: longint; {22kHz = $56ee8ba3}
                    loopstart: Ptr;
                    loopend: Ptr;
                    encoding: Byte;{0}
                    basenote: Byte; { $3c}
{data}
                    ljud: packed array[0..0] of Byte;
                end;
            msrp = ^mySndRec;
            msrh = ^msrp;
        var
            h: msrh;
    begin
        h := msrh(NewHandle(sizeof(mySndRec) + size));
        if h = nil then
            CreateSnd := false
        else
            begin
                HLock(Handle(h)); {Fixar detta buggen med att ljuden ändras?}
                with h^^ do
                    begin
                        format := 1;
                        numsynth := 1;
                        synthid := 5;
                        synthinit := 0;
                        numcom := 1;
                        command := $8051;
                        param1 := 0;
                        param2 := $14;
                        dataptr := @ljud[0];
                        datasize := size;
                        samplerate := $56ee8ba3; {div 2 - fast varför köra 11kHz när man synthar?!}
                        loopstart := dataptr;
                        loopend := dataptr; {?}
                        encoding := 0;
                        basenote := $3c;
                        dataPek := dataptr; {Utdata}
                    end; {with}
                SndH := handle(h);{utdata}
                CreateSnd := true;
            end; {if nil else}
    end;{CreateSnd}

    var
        pushH, bippH, baeH: Handle;

{Fixa några bra subrutiner för ljudsyntning?!}
{- Eko}
{- Lågpass och högpass}
{- Sampla upp eller ner?}
{- Frekvensvariation?}
{- Fade in, fade out (mm envelope)}
{Drömmen är förstås FFT, så man kan göra riktigt vass bandspärr, frekvensskift mm.}
{Apropå: kan man inte göra bra ljudkompression med FFT?}

{$PUSH}
{$R-}

{Rutinen som skall bygga de syntetiska ljud vi önskar!}
    procedure Synth;
        type
            ArtRec = record
                    arr: packed array[0..10000] of Byte;
                end;
            ArtPtr = ^ArtRec;
        var
            tmpPtr: ArtPtr;
            i: integer;
        const
            pushSize = 3479;
            bippSize = 2959;
            baeSize = 20000;
    begin
        if not CreateSnd(pushSize + 1, pushH, Ptr(tmpptr)) then
            CheckNoMem(nil); {EmergencyExit}
        for i := 0 to pushSize do
            tmpptr^.arr[i] := band(char(random), 127) * (pushSize - i) div pushSize + 128;
        for i := 0 to pushSize - 3 do
            tmpptr^.arr[i] := (tmpptr^.arr[i] + tmpptr^.arr[i + 1] + tmpptr^.arr[i + 2] + tmpptr^.arr[i + 3]) div 4;
        for i := 0 to 64 do
            begin
{tmpptr^.arr[i] := tmpptr^.arr[i] * i div 64;}
                tmpptr^.arr[pushSize - i] := tmpptr^.arr[pushSize - i] * i div 64;
            end;

        if not CreateSnd(bippSize + 1, bippH, Ptr(tmpptr)) then
            CheckNoMem(nil); {EmergencyExit}
        for i := 0 to bippSize do
            tmpptr^.arr[i] := i mod (i div 171 + 1) mod 127 + 128; {mjiioo}
{tmpptr^.arr[i] := i mod (i div 171 + 1) + 128; {mjiioo}
{tmpptr^.arr[i] := i mod (i div 17 + 1) + 128; {maipp}
{tmpptr^.arr[i] := band(i, 63) + 128;}
        for i := 0 to 64 do
            begin
                tmpptr^.arr[i] := tmpptr^.arr[i] * i div 64;
                tmpptr^.arr[bippSize - i] := tmpptr^.arr[bippSize - i] * i div 64;
            end;

        if not CreateSnd(baeSize + 1, baeH, Ptr(tmpptr)) then
            CheckNoMem(nil); {EmergencyExit}
        for i := 0 to baeSize do
            tmpptr^.arr[i] := (i div 5) mod (i div 1571 + 1) mod 127 + 128; {mjiioo}
{tmpptr^.arr[i] := i mod (i div 171 + 1) + 128; {mjiioo}
{tmpptr^.arr[i] := i mod (i div 17 + 1) + 128; {maipp}
{tmpptr^.arr[i] := band(i, 63) + 128;}
        for i := 0 to baeSize - 3 do
            tmpptr^.arr[i] := (tmpptr^.arr[i] + tmpptr^.arr[i + 1] + tmpptr^.arr[i + 2] + tmpptr^.arr[i + 3]) div 4;
        for i := 0 to 64 do
            begin
                tmpptr^.arr[i] := tmpptr^.arr[i] * i div 64;
                tmpptr^.arr[baeSize - i] := tmpptr^.arr[baeSize - i] * i div 64;
            end;
    end;
{$POP}

    procedure DoAbout;
    begin
        if 1 = Alert(aboutAlrt, nil) then
            ;
    end;

{Two handly routines from my dialog utilities unit.}
    procedure SetTextDItem (theDialog: DialogPtr; itemNo: integer; theString: Str255);
        var
            kind: integer;
            item: ControlHandle;
            box: Rect;
    begin
        GetDItem(theDialog, itemNo, kind, Handle(item), box);
{Check kind}
        kind := BitAnd(kind, 127);
        case kind of
            8, 16: {statText, editText}
                SetIText(handle(item), theString);
            0, 1, 2, 4, 5, 6: {button, checkbox, radio - men vad är 4?}
                SetCTitle(item, theString);
            otherwise {Övriga har ingen text man kan sätta}
                SysBeep(1);
        end;{case}
    end;
    function GetTextDItem (theDialog: DialogPtr; itemNo: integer): Str255;
        var
            kind: integer;
            item: ControlHandle;
            box: Rect;
            tmpStr: Str255;
    begin
        GetDItem(theDialog, itemNo, kind, Handle(item), box);
{Check kind}
        kind := BitAnd(kind, 127);
        tmpStr := '';
        case kind of
            8, 16: {statText, editText}
                GetIText(handle(item), tmpStr);
            0, 1, 2, 4, 5, 6: {button, checkbox, radio…?}
                GetCTitle(item, tmpStr);
            otherwise {Övriga har ingen text man kan sätta}
                SysBeep(1);
        end;{case}
        GetTextDItem := tmpStr;
    end;
    function MyNumToString (l: longint): Str255;
        var
            tmpStr: Str255;
    begin
        NumToString(l, tmpStr);
        MyNumToString := tmpStr;
    end;

{Make the new high score dialog}
    procedure AskHigh;
        const
            highDlogID = 129;
        var
            dialog: DialogPtr;
            oldPort: GrafPtr;
            itemHit: integer;
            str: str255;
    begin
        GetPort(oldPort);
        dialog := GetNewDialog(highDlogID, nil, WindowPtr(-1));
        ShowWindow(dialog);
        SelectWindow(dialog);
        SetPort(dialog);

        SetTextDItem(dialog, 3, settings^^.player);
        SelIText(dialog, 3, 0, 32767);
        itemHit := -1;
        while (itemHit <> 1) and (itemHit <> 2) do { 1=ok, 2=cancel }
            ModalDialog(nil, itemHit);
        if itemHit = 1 then
            begin
                str := GetTextDItem(dialog, 3);
                if length(str) > 5 then
                    str[0] := char(5); {snabbaste sättet att korta den!}
                settings^^.player := str;
                settings^^.high := score;
            end;
        DisposeDialog(dialog);
        SetPort(oldPort);
    end;

{Reuseable sprite movement routine, called from all sprite handling routines. Some sprites use this}
{as handling routine.}
    procedure SATBounce (me: SpritePtr);
    begin
        me^.position.h := me^.position.h + me^.speed.h;
        me^.position.v := me^.position.v + me^.speed.v;
        if me^.position.h < 0 then
            me^.speed.h := abs(me^.speed.h);
        if me^.position.h > gSAT.offSizeH - me^.hotRect.right then
            me^.speed.h := -abs(me^.speed.h);
        if me^.position.v < 0 then
            me^.speed.v := abs(me^.speed.v);
        if me^.position.v > gSAT.offSizeV - me^.hotRect.bottom then
            me^.speed.v := -abs(me^.speed.v);
    end;

{The same but using fixed-point position, as in HandlePlayer}
    procedure SATFixedBounce (me: SpritePtr);
    begin
        me^.fixedPos.h := me^.fixedPos.h + me^.speed.h;
        me^.fixedPos.v := me^.fixedPos.v + me^.speed.v;

        me^.position.h := BSR(me^.fixedPos.h, 4); {Shift left 4 steps, i.e. div 16}
        me^.position.v := BSR(me^.fixedPos.v, 4);

{Since BSR isn't aritmetic shift, a negative fixedPos will unfortunately result in}
{a very large positive position. This must be accounted for when checking borders}
{- or we could use div, but that is slower.}

        if me^.fixedPos.h < 0 then
            begin
                me^.speed.h := abs(me^.speed.h);
                me^.position.h := 0;
            end
        else if me^.position.h > gSAT.offSizeH - me^.hotRect.right then
            me^.speed.h := -abs(me^.speed.h);
        if me^.fixedPos.v < 0 then
            begin
                me^.speed.v := abs(me^.speed.v);
                me^.position.v := 0;
            end
        else if me^.position.v > gSAT.offSizeV - me^.hotRect.bottom then
            me^.speed.v := -abs(me^.speed.v);
    end;


    procedure HandleTheSprite (me: SpritePtr);
    begin
        if me^.speed.h = 0 then
            me^.speed.h := Rand(32) - Rand(32);
        if me^.speed.v = 0 then
            me^.speed.v := Rand(32) - Rand(32);
        if me^.face = nil then
            begin
                me^.face := myFace;
                if me^.face <> nil then
                    me^.hotRect := me^.face^.iconMask.bounds;
            end;
        SATFixedBounce(me);
    end;

    procedure RedrawScoreFace;
    begin
        SetPortFace(scoreFace);
        EraseRect(scoreFace^.iconMask.bounds);
        MoveTo(2, 14);
        ForeColor(blackColor);
        DrawString('Score:');
        DrawLong(score);
        ForeColor(whiteColor);
        MoveTo(0, 12);
        DrawString('Score:');
        DrawLong(score);
        ForeColor(blackColor);
        SATSetPortScreen;
        SetPortMask(scoreFace);
        EraseRect(scoreFace^.iconMask.bounds);
        MoveTo(0, 12);
        DrawString('Score:');
        DrawLong(score);
        MoveTo(2, 14);
        DrawString('Score:');
        DrawLong(score);
        SATSetPortScreen;
        ChangedFace(scoreFace);
    end;

    procedure RedrawHighFace;
        var
            str: Str255;
    begin
        str := stringof('High score:', MyNumToString(settings^^.high), ' by ', settings^^.player);

        SetPortFace(highFace);
        EraseRect(highFace^.iconMask.bounds);
        MoveTo(2, 14);
        ForeColor(blackColor);
        DrawString(str);
        ForeColor(whiteColor);
        MoveTo(0, 12);
        DrawString(str);
        ForeColor(blackColor);
        SATSetPortScreen;
        SetPortMask(highFace);
        EraseRect(highFace^.iconMask.bounds);
        MoveTo(0, 12);
        DrawString(str);
        MoveTo(2, 14);
        DrawString(str);
        SATSetPortScreen;
        ChangedFace(highFace);
    end;

    procedure RedrawLastFace;
    begin
        SetPortFace(lastface);
        EraseRect(lastface^.iconMask.bounds);
        MoveTo(2, 14);
        DrawString('Last score:');
        DrawLong(score);
        ForeColor(whiteColor);
        MoveTo(0, 12);
        DrawString('Last score:');
        DrawLong(score);
        ForeColor(blackColor);
        SATSetPortScreen;
        SetPortMask(lastface);
        EraseRect(lastface^.iconMask.bounds);
        MoveTo(0, 12);
        DrawString('Last score:');
        DrawLong(score);
        MoveTo(2, 14);
        DrawString('Last score:');
        DrawLong(score);
        SATSetPortScreen;
        ChangedFace(lastface);
    end;

    var
        playerFace: array[0..15] of FacePtr;
        playerSpeed: array[0..15] of Point;





{Redraw all player faces. This is separated from InitPlayerFaces since it must be called on}
{depth changes.}
    procedure ReDrawPlayerFaces;
        const
            totalAngle = 240;
        var
            i: integer;
            r, r1, r2, ri: Rect;
            reg1, reg2: RgnHandle;
            pol: PolyHandle;
    begin
        SetRect(r, 0, 0, 40, 40); {Total face size}
        SetRect(r1, 0, 0, 38, 38); {Colored part}
        SetRect(ri, 9, 9, 29, 29); {Colored part, inner circle}
        SetRect(r2, 2, 2, 40, 40); {Shadow}
        for i := 0 to 15 do
            begin
                reg1 := NewRgn;
                reg2 := NewRgn;

{Generate shape}
                SetPortMask(playerFace[i]);
                PaintArc(r1, i * 360 div 16 - (360 - totalAngle) div 2, totalAngle);
                EraseArc(ri, i * 360 div 16 - (360 - totalAngle) div 2, totalAngle); {360-graders-skala}
                if noErr <> BitMapToRegionGlue(reg1, playerFace[i]^.iconMask) then{}
                    ;
                CopyRgn(reg1, reg2);
                OffsetRgn(reg2, 2, 2);

{Draw face}
                SetPortFace(playerFace[i]);
                EraseRect(playerFace[i]^.iconMask.bounds);
                ForeColor(blackColor);
                FillRgn(reg2, black); {black "Shadow"}
                ForeColor(cyanColor);
                if gSAT.initDepth > 1 then
                    FillRgn(reg1, black) {If we run in color, fill it completely with cyan}
                else
                    FillRgn(reg1, ltGray); {If we run in b/w, a gray pattern looks nicer}
                ForeColor(blueColor);
                FrameRgn(reg1);
                ForeColor(blackColor);
{Draw mask}
                SetPortMask(playerFace[i]);
                EraseRect(playerFace[i]^.iconMask.bounds);
                FillRgn(reg1, black);
                FillRgn(reg2, black);
                SATSetPortScreen;
                ChangedFace(playerFace[i]);

                DisposeRgn(reg1);
                DisposeRgn(reg2);
            end;
    end;

{Create all player faces.}
    procedure InitPlayerFaces;
        var
            i: integer;
            r: Rect;
    begin
{We use crude approximations to the sine/cosine functions we really want.}
{A real game might init the table by using sine and cosine for real, but I don't}
{want to make this harder to read than it already is. A real game would also}
{use more than 16 directions, say 32 or even 64.}

        SetPt(playerSpeed[6], 0, -6);
        SetPt(playerSpeed[7], 2, -5);
        SetPt(playerSpeed[8], 4, -4);
        SetPt(playerSpeed[9], 5, -2);
        SetPt(playerSpeed[10], 6, 0);
        SetPt(playerSpeed[11], 5, 2);
        SetPt(playerSpeed[12], 4, 4);
        SetPt(playerSpeed[13], 2, 5);
        SetPt(playerSpeed[14], 0, 6);
        SetPt(playerSpeed[15], -2, 5);
        SetPt(playerSpeed[0], -4, 4);
        SetPt(playerSpeed[1], -5, 2);
        SetPt(playerSpeed[2], -6, 0);
        SetPt(playerSpeed[3], -5, -2);
        SetPt(playerSpeed[4], -4, -4);
        SetPt(playerSpeed[5], -2, -5);

        SetPt(playerSpeed[6], 0, -32);
        SetPt(playerSpeed[7], 14, -28);
        SetPt(playerSpeed[8], 22, -22);
        SetPt(playerSpeed[9], 28, -14);
        SetPt(playerSpeed[10], 32, 0);
        SetPt(playerSpeed[11], 28, 14);
        SetPt(playerSpeed[12], 22, 22);
        SetPt(playerSpeed[13], 14, 28);
        SetPt(playerSpeed[14], 0, 32);
        SetPt(playerSpeed[15], -14, 28);
        SetPt(playerSpeed[0], -22, 22);
        SetPt(playerSpeed[1], -28, 14);
        SetPt(playerSpeed[2], -32, 0);
        SetPt(playerSpeed[3], -28, -14);
        SetPt(playerSpeed[4], -22, -22);
        SetPt(playerSpeed[5], -14, -28);

        SetRect(r, 0, 0, 40, 40); {Total face size}
        for i := 0 to 15 do
            begin
                playerFace[i] := NewFace(r);
                ChangedFace(playerFace[i]);
            end;
        RedrawPlayerFaces;
    end;

    procedure HandlePlayer (me: SpritePtr);
    begin
        me^.mode := gMode;
        me^.face := playerFace[me^.mode];

        me^.fixedPos.h := me^.fixedPos.h + playerSpeed[me^.mode].h;
        me^.fixedPos.v := me^.fixedPos.v + playerSpeed[me^.mode].v;

        me^.position.h := BSR(me^.fixedPos.h, 4); {Shift left 4 steps, i.e. div 16}
        me^.position.v := BSR(me^.fixedPos.v, 4);

        if me^.fixedPos.h < 0 then
            begin
                me^.position.h := 0;
                me^.fixedPos.h := 0;
{gMode := BitAnd(BitAnd(4 - gMode, 15) + 4, 15);}
            end;
        if me^.position.h > gSAT.offSizeH - me^.hotRect.right then
            begin
                me^.position.h := gSAT.offSizeH - me^.hotRect.right;
                me^.fixedPos.h := BSL(me^.position.h, 4); {*16}
{gMode := BitAnd(BitAnd(4 - gMode, 15) + 4, 15);}
            end;
        if me^.fixedPos.v < 0 then
            begin
                me^.position.v := 0;
                me^.fixedPos.v := 0;
{gMode := BitAnd(-gMode, 15);}
            end;
        if me^.position.v > gSAT.offSizeV - me^.hotRect.bottom then
            begin
                me^.position.v := gSAT.offSizeV - me^.hotRect.bottom;
                me^.fixedPos.v := BSL(me^.position.v, 4); {*16}
{gMode := BitAnd(-gMode, 15);}
            end;
    end;

{Get a vector from center to center of two sprites}
    function Vector (s1, s2: SpritePtr): Point;
    begin
        Vector.h := s1^.position.h + s1^.face^.iconMask.bounds.right div 2 - s2^.position.h - s2^.face^.iconMask.bounds.right div 2;
        Vector.v := s1^.position.v + s1^.face^.iconMask.bounds.right div 2 - s2^.position.v - s2^.face^.iconMask.bounds.right div 2;
    end;

{Squared distance between centers of two sprites}
    function Dist2 (s1, s2: SpritePtr): Longint;
        var
            v: Point;
    begin
        v := Vector(s1, s2);
        Dist2 := v.h * v.h + v.v * v.v;
    end;

    procedure HitPlayer (me, him: SpritePtr);
        var
            r1, r2: RgnHandle;
            v: Point;
    begin
{We know that out hotRects coincide. However, that doesn't mean that we must take it as a}
{collision! Rather, we can do more processing here to decide whether or not it was a collision.}
{In this case, we copy the mask regions of each sprite, offset them to the proper positions,}
{and check if they, too, overlap!}
{}
{Do you think we are doing double work, both dealing with hotRects and the regions? If you do,}
{let me explain some more. The idea is that SAT checks the hotRects for you, which takes away}
{next to all false hits. Checking hotRects is *fast*, so that's what we can afford to do all-to-all}
{(or all-to-near, depending on the chosen search mode). Once a *possible* collision is detected,}
{we can spend some time analyzing it further!}

{First of all, let's do some error checking. We could also have done this when loading the faces.}
{Most programs won't have to bother whether or not the regions have been generated}
{successfully, but when using them this way, they must exist or we may get a crash.}
        if (me^.face^.maskRgn = nil) or (him^.face^.maskRgn = nil) then
            begin
                ReportStr('Error: No mask region!');
                exit(HitPlayer);
            end;

{Make copies of the mask regions and offset them to the proper places.}
        r1 := NewRgn;
        r2 := NewRgn;
        CopyRgn(me^.face^.maskRgn, r1);
        CopyRgn(him^.face^.maskRgn, r2);
        OffsetRgn(r1, me^.position.h, me^.position.v);
        OffsetRgn(r2, him^.position.h, him^.position.v);

        SectRgn(r1, r2, r1);                    {Is there any overlap?}

{If empty, no collision, otherwise, handle the collision!}
        if not EmptyRgn(r1) then
            begin

                if Dist2(me, him) > 60 then
                    begin
{Hit too far out, so let's call it the outside. Bounce away him.}
{We could make more efforts here for a good bounce.}
                        him^.position.h := him^.position.h + me^.speed.h;
                        him^.speed.h := -him^.speed.h + me^.speed.h;
                        him^.position.v := him^.position.v + me^.speed.v;
                        him^.speed.v := -him^.speed.v + me^.speed.v;
{Finally, make sure the other is moving *away* from us!}
{And when we're at it, why not move it just a little, too?}
{Yuck, this is ugly! Yup, careless programming. Hack, hack!}
                        v := Vector(me, him);
                        if v.h > 0 then
                            begin
                                if him^.speed.h > 0 then
                                    him^.speed.h := -him^.speed.h;
                                him^.position.h := him^.position.h - 1;
                            end
                        else
                            begin
                                if v.h < 0 then
                                    if him^.speed.h < 0 then
                                        him^.speed.h := -him^.speed.h;
                                him^.position.h := him^.position.h + 1;
                            end;
                        if v.v > 0 then
                            begin
                                if him^.speed.v > 0 then
                                    him^.speed.v := -him^.speed.v;
                                him^.position.v := him^.position.v - 1;
                            end
                        else
                            begin
                                if v.v < 0 then
                                    if him^.speed.v < 0 then
                                        him^.speed.v := -him^.speed.v;
                                him^.position.v := him^.position.v + 1;
                            end;

                    end
                else
                    begin
{This looks like inside! Let's eat him.}
                        score := score + 1;
                        RedrawScoreFace;
                        him^.task := nil;
                        SATSoundPlay(bippH, 1, true);
                    end; {Dist2}
            end; {not EmptyRgn}

        DisposeRgn(r1);
        DisposeRgn(r2);
    end;

    procedure InitScoreFace;
        var
            r: Rect;
    begin
        SetRect(r, 0, 0, 80, 14);{}
        scoreFace := NewFace(r);{NewFace gör "Application zone damaged!" Det är inte bredden.}
        ChangedFace(scoreFace);
{RedrawScoreFace; {MEN MED DENNA blev det inga problem!!!}
{Slutsats: NewFace lämnar nånting i fel skick, men ChangedFace fixar det!}
        SetRect(r, 0, 0, 200, 16);{}
        highFace := NewFace(r);{NewFace gör "Application zone damaged!" Det är inte bredden.}
        ChangedFace(highFace);
        SetRect(r, 0, 0, 120, 16);{}
        lastFace := NewFace(r);{NewFace gör "Application zone damaged!" Det är inte bredden.}
        ChangedFace(lastFace);
{RedrawHighFace; {MEN MED DENNA blev det inga problem!!!}
    end;

    procedure SetupDummy (me: SpritePtr);
    begin
        me^.task := @SATBounce;
    end;

    procedure SetupSmall (me: SpritePtr);
    begin
        me^.face := myFace;
        me^.hotRect := me^.face^.iconMask.bounds;
        me^.task := @HandleTheSprite;

        me^.fixedPos.h := BSL(me^.position.h, 4); {*16}
        me^.fixedPos.v := BSL(me^.position.v, 4); {*16}
    end;

    procedure SetupPlayer (me: SpritePtr);
    begin
        me^.face := playerFace[0];
        me^.hotRect := me^.face^.iconMask.bounds;
        me^.task := @HandlePlayer;
        me^.hitTask := @HitPlayer;

        me^.fixedPos.h := BSL(me^.position.h, 4); {*16}
        me^.fixedPos.v := BSL(me^.position.v, 4); {*16}
    end;


    procedure NewSet;
        var
            sp: SpritePtr;
            i: integer;
    begin
{Kill all sprites}
        while gSAT.sRoot <> nil do
            KillSprite(gSAT.sRoot);

{Create the pills}
        for i := 1 to 10 do
            sp := NewSprite(-1, Rand(gSAT.offSizeH - 32), Rand(gSAT.offSizeV - 32), @SetupSmall);
        if settings^^.high > 7 then
            for i := 8 to settings^^.high do
                sp := NewSprite(-1, Rand(gSAT.offSizeH - 32), Rand(gSAT.offSizeV - 32), @SetupSmall);

        sp := NewSprite(0, Rand(gSAT.offSizeH - 32), Rand(gSAT.offSizeV - 32), @SetupDummy);
        RedrawScoreFace;
        sp^.face := scoreFace;
        repeat
            sp^.speed.h := Rand(5) - 2
        until sp^.speed.h <> 0;
        repeat
            sp^.speed.v := Rand(3) - 1
        until sp^.speed.v <> 0;
        sp^.hotRect := sp^.face^.iconMask.bounds;
{Hoppsan- fattas nåt!}

        sp := NewSprite(1, (gSAT.offSizeH - 32) div 2, (gSAT.offSizeV - 32) div 2, @SetupPlayer);
        gMode := 0;

        SATBackChanged(gSAT.bounds);
        setCount := setCount + 1;
        FlushEvents(6, 0); {Glöm klick från förra uppsättningen!}
        if not (TickCount > gameStartTime + kGameTime) then {Om tiden INTE är ute så skall vi ändra!}
            lastSetStartTime := TickCount;
    end;

{An example of how you can (with some effort) scale a sprite.}
    procedure ScaleWelcomeFace;
        var
            srcFacePort, destFacePort: GrafPtr;
            i: integer;
            scaleRect: Rect;
    begin
{Get the rectangle of the original}
        scaleRect := welcomeFace^.iconMask.bounds;

        for i := 0 to 31 do
            begin
{SetPortFace to the source. This must be done each turn since ChangedFace changes it.}
                SetPortFace(welcomeFace); {Set the FIRST of SAT's two internal face-ports to the original face.}
                GetPort(srcFacePort); {Get the port.}
{Modify the size}
                scaleRect.bottom := scaleRect.bottom - 2;
                scaleRect.right := scaleRect.right - 2;
{Create the new face}
                if scaledFace[i] = nil then
                    scaledFace[i] := NewFace(scaleRect);
{Get a port to it}
                SetPortFace2(scaledFace[i]); {Set the SECOND of SAT's two internal face ports to the new face.}
                GetPort(destFacePort); {Get the port.}
{Copy the image}
                CopyBits(srcFacePort^.portBits, destFacePort^.portBits, welcomeFace^.iconMask.bounds, scaleRect, srcCopy + ditherCopy, nil);
                CopyBits(welcomeFace^.iconMask, scaledFace[i]^.iconMask, welcomeFace^.iconMask.bounds, scaleRect, srcCopy, nil);
                ChangedFace(scaledFace[i]); {Done changing it. Tell SAT that it may do whatever it needs.}
            end; {for}
    end; {ScaleWelcomeFace}

    procedure WindUpdate (whatever: Boolean);
        var
            savePort: GrafPtr;
            saveDev: GDHandle;
    begin
        if SATDepthChangeTest then
{IMPORTANT! We must redraw all internally generated faces on depth changes!}
            begin
                ReDrawPlayerFaces;
                RedrawScoreFace;
                RedrawHighFace;
                RedrawLastFace;
                ScaleWelcomeFace;

{We also have to redraw the background, since it's not a PICT (in which case that is automatic)}
                GetPort(savePort);
                if colorFlag then
                    saveDev := GetGDevice;
                SATSetPortBackScreen;
                SATPenPat(bgPat);
                PaintRect(gSAT.backScreen^.portRect);
                PenNormal;
                CopyBits(gSAT.backScreen^.portBits, gSAT.offScreen^.portBits, gSAT.offScreen^.portRect, gSAT.offScreen^.portRect, srcCopy, nil);
                SetPort(savePort);
                if colorFlag then
                    SetGDevice(saveDev);

            end;
        PeekOffscreen;
    end;

    procedure WindClose;
    begin
        SkelWhoa;
    end;

    procedure WindMouse (where: Point; when: Longint; modifiers: integer);
        var
            found, sp: SpritePtr;
            anyLeft: Boolean;
            myRegion: RgnHandle;
    begin
{Not needed for the game, but note that we can check the mask region of a sprite}
{towards a mouse click as well as a colliding sprite! For demonstrating this, mouse}
{clicks are processed, and if a sprite is hit, a SysBeep is made. Try this by clicking}
{in and around the "Hello" sprite!}

        myRegion := NewRgn;
        sp := gSAT.sRoot;
        found := nil;
        while sp <> nil do                                        {Search through the sprite list}
            begin
                if PtInRect(where, sp^.r) then                        {We are in the rect!}
                    if sp^.face <> nil then                            {Does it have a face at all? Remember it's legal not to have one!}
                        if sp^.face^.maskRgn <> nil then                {Does that face have a mask region? It should, but…}
                            begin
                                CopyRgn(sp^.face^.maskRgn, myRegion);    {Copy the mask region}
                                OffsetRgn(myRegion, sp^.position.h, sp^.position.v);        {Offset it to the position of the sprite}
                                if PtInRgn(where, myRegion) then            {Are we in the region?}
                                    found := sp;                                    {Yes!}
                            end;
                sp := sp^.next;                                        {Next sprite…}
            end;
        if found <> nil then
            SysBeep(1);                                            {We hit something. Tell us so.}
        DisposeRgn(myRegion);
    end;


    procedure WindKey (theKey: char; theMods: integer);
    begin
{Hard-coded keys; real games have customizable keys.}
        case theKey of
            ',', 'z', '1':
                gMode := BitAnd(gMode - 1, 15);
            '.', 'x', '2':
                gMode := BitAnd(gMode + 1, 15);
            otherwise
        end; {case}
        ObscureCursor; {Hide the cursor until the mouse is moved.}
    end;

    procedure SetupSAT (theWind: WindowPtr);{Calls CustomInitSAT and paints the background with a pattern}
        var
            saveport: GrafPtr;
            savedev: GDHandle;
    begin
        CustomInitSAT(0, 0, theWind^.portRect, theWind, nil, false, false, false, true, false); {Nytt försök!}

{We use a customized sprite record! Thus, we must SetSpriteSize before creating sprites!}
        SATSetSpriteRecSize(sizeof(Sprite));

        if bgPat = nil then
            bgPat := SATGetPat(128);
        if bgPat = nil then
            Barf;

        SATGetPort(savePort, saveDev);

        SATSetPortBackScreen;
        SATPenPat(bgPat);
        PaintRect(gSAT.backScreen^.portRect);
        PenNormal;
        CopyBits(gSAT.backScreen^.portBits, gSAT.offScreen^.portBits, gSAT.offScreen^.portRect, gSAT.offScreen^.portRect, srcCopy, nil);

        SATSetPort(savePort, saveDev);
        CopyBits(gSAT.backScreen^.portBits, gSAT.wind^.portBits, gSAT.wind^.portRect, gSAT.wind^.portRect, srcCopy, nil);

        if SkelWindow(theWind, @WindMouse, @WindKey, @WindUpdate, nil, @WindClose, nil, nil, false) then
            ;
    end;

    procedure SetupWindow;
        var
            slaskWind, theWind: WindowPtr;
            tmpWorld: SysEnvRec;
            tmpCol: Boolean;
{r: Rect;}
{peek: WindowPeek;}
    begin
        tmpCol := false;
        if noErr = SysEnvirons(1, tmpWorld) then
            tmpCol := tmpWorld.hasColorQD;

        if tmpCol then
            theWind := GetNewCWindow(theWindRes, nil, WindowPtr(-1))
        else
            theWind := GetNewWindow(theWindRes, nil, WindowPtr(-1));

{peek := WindowPeek(theWind);}

        if theWind = nil then
            Barf;

{MoveWindow(theWind, 50, 50, false);}

{r := WindowPeek(theWind)^.contRgn^^.rgnBBox;}

{slaskWind := theWind;}

        SetupSAT(theWind); {Calls CustomInitSAT and paints the background with a pattern}

        ShowWindow(gSAT.wind);
        SelectWindow(gSAT.wind);
        SetPort(gSAT.wind);
        PeekOffScreen;
    end;

{The task the welcome sprite has while zooming.}
    procedure ZoomWelcome (me: SpritePtr);
    begin
        me^.mode := me^.mode + 1;
{Compensate for the size change to make it centered in one place.}
        me^.position.h := me^.position.h - 1;
        me^.position.v := me^.position.v - 1;
        if me^.mode >= 32 then
            begin
                me^.face := welcomeFace;
                me^.task := @SATBounce;
            end
        else
            me^.face := scaledFace[32 - me^.mode];
    end;

{Initialize faces.}
    procedure InitSpriteFaces;
        var
            i: integer;
    begin
        myFace := GetFace(128);
        if myFace = nil then
            Barf;
        welcomeFace := GetFace(138);
        if welcomeFace = nil then
            Barf;
{We don't HAVE to bail out when a face fails to load - the program will stll wor, but that face will}
{not be visible.}
        ScaleWelcomeFace;
    end;

    var
        lastTime: Longint;

{DirtyWork is called from TransSkel}
    procedure DirtyWork;
        var
            sp: SpritePtr;
            ph: PicHandle;
            r: Rect;
            savePort: GrafPtr;
            saveDev: GDHandle;
    begin
{We can check TickCount as usual, since we never know how often we get null events.}
        if lastTime + 1 < TickCount then
            begin
                RunSAT(false);
                lastTime := tickCount;
            end;

        if gameRunning then
            begin
{Timebar}
                GetPort(savePort);
                if colorFlag then
                    saveDev := GetGDevice;
                SATSetPortBackScreen;
{I *should* change only the part that actually changes!}
                r := gSAT.wind^.portRect;
                SATBackChanged(r);
                r.right := 5;
                r.top := r.bottom * (lastSetStartTime + kGameTime - TickCount) div kGameTime;
                ForeColor(redColor); {Quickest way to get a color.}
                PaintRect(r);
                r.bottom := r.top;
                r.top := 0;
                SATPenPat(bgPat);
                PaintRect(r);
                PenNormal;

                SetPort(savePort);
                if colorFlag then
                    SetGDevice(saveDev);
{end of Timebar}

                if TickCount > lastSetStartTime + kGameTime then
                    begin
                        SATSoundPlay(baeH, 5, true);
{NewSet;}

                        if TickCount > gameStartTime + kGameTime then
                            begin
                                if score > settings^^.high then
                                    begin
{settings^^.high := score;}
                                        SATSoundEvents;
                                        AskHigh;
{ReportStr(stringof('New highscore: ', score, ' points! Whoopie!'));}
                                        ChangedResource(Handle(settings));
                                    end;

{Kill all sprites}
                                while gSAT.sRoot <> nil do
                                    KillSprite(gSAT.sRoot);

                                RedrawHighFace;
                                RedrawLastFace;
{Time for breaking some of my conventions! The stuff below should be done in "setup" and "handle"}
{routines, as recommened in the manual and done in other demos - but if we want to mess up the code,}
{we are free to do so! The sprites below set up their faces and speeds right here, and share a common}
{handling routine (SATBounce).}

{Make the "hello" sprite}
                                sp := NewSprite(0, gSAT.offSizeH div 2, gSAT.offSizeV div 2, @SetupDummy);
                                sp^.face := welcomeFace;
                                repeat
                                    sp^.speed.h := Rand(3) - 1
                                until sp^.speed.h <> 0;
                                repeat
                                    sp^.speed.v := Rand(3) - 1
                                until sp^.speed.v <> 0;
                                sp^.hotRect := sp^.face^.iconMask.bounds;
                                sp^.task := @ZoomWelcome;
{High score sprite}
                                sp := NewSprite(0, gSAT.offSizeH div 2, gSAT.offSizeV div 4, @SetupDummy);
                                sp^.face := highFace;
                                repeat
                                    sp^.speed.h := Rand(7) - 3
                                until sp^.speed.h <> 0;
                                repeat
                                    sp^.speed.v := Rand(3) - 1
                                until sp^.speed.v <> 0;
                                sp^.hotRect := sp^.face^.iconMask.bounds;
{Last score sprite}
                                sp := NewSprite(0, gSAT.offSizeH div 2, gSAT.offSizeV div 3, @SetupDummy);
                                sp^.face := lastFace;
                                repeat
                                    sp^.speed.h := Rand(7) - 3
                                until sp^.speed.h <> 0;
                                repeat
                                    sp^.speed.v := Rand(3) - 1
                                until sp^.speed.v <> 0;
                                sp^.hotRect := sp^.face^.iconMask.bounds;

                                SATSetPortScreen;
                                PeekOffscreen; {Just to make sure killed sprites are erased}
                                gameRunning := false;
                            end;

                    end;
            end;

        if not gameRunning then
            if gSAT.sRoot = nil then
                begin
{Messy code for setting up the "hello" sprite - which is why I recommend the use of setup routines.}
                    sp := NewSprite(0, gSAT.offSizeH div 2, gSAT.offSizeV div 2, @SetupDummy);
                    sp^.face := welcomeFace;
                    repeat
                        sp^.speed.h := Rand(3) - 1
                    until sp^.speed.h <> 0;
                    repeat
                        sp^.speed.v := Rand(3) - 1
                    until sp^.speed.v <> 0;
                    sp^.hotRect := sp^.face^.iconMask.bounds;
                    sp^.task := @ZoomWelcome;
                end;
    end;

    procedure InitHigh;
    begin
        settings := SettingsHnd(GetResource('Sett', 0));
        if settings = nil then {Didn't exist - create it!}
            begin
                settings := SettingsHnd(NewHandle(Sizeof(SettingsRec)));
                if settings = nil then
                    begin
                        SysBeep(1);
                        halt;
                    end;
                settings^^.high := 0;
                AddResource(handle(settings), 'Sett', 0, '');
            end
        else {Did exist - check the size!}
            if GetHandleSize(Handle(settings)) < sizeof(SettingsRec) then
                SetHandleSize(Handle(settings), sizeof(SettingsRec));
    end;

    procedure DoFileMenu (item: integer);
    begin
        case item of
            newGameItem:
                begin
                    score := 0;
                    gameRunning := true;
                    gameStartTime := TickCount;
                    lastSetStartTime := TickCount;
                    setCount := 0;
                    NewSet;

                    ObscureCursor; {Hide the cursor until the mouse is moved.}
                end;
            clearHighItem:
                if QuestionStr('Set the high score to zero?') then
                    begin
                        settings^^.high := 0;
                        ChangedResource(handle(settings));
                    end;
            otherwise
                SkelWhoa;
        end;
    end;

    procedure DoShapeMenu (item: integer);
        const
            wide = 1;
            tall = 2;
        var
            p: Point;
    begin
        p := gSAT.wind^.portRect.botRight;
        case item of
            wide:
                if gSAT.wind^.portRect.bottom > gSAT.wind^.portRect.right then
                    begin
                        CheckItem(shapeMenu, wide, true);
                        CheckItem(shapeMenu, tall, false);
                        SizeWindow(gSAT.wind, p.v, p.h, false); {swap size}
                        KillSAT;
                        SetupSAT(gSAT.wind);
                        gameRunning := false;
                    end;
            tall:
                if gSAT.wind^.portRect.bottom < gSAT.wind^.portRect.right then
                    begin
                        CheckItem(shapeMenu, tall, true);
                        CheckItem(shapeMenu, wide, false);
                        SizeWindow(gSAT.wind, p.v, p.h, false); {swap size}
                        KillSAT;
                        SetupSAT(gSAT.wind);
                        gameRunning := false;
                    end;
            otherwise
                SysBeep(1);
        end;{case}
    end;

    procedure SetUpMenus;
    begin
        SkelApple('About CollisionIII…', @DoAbout);
        fileMenu := GetMenu(fileMenuRes);
        if fileMenu = nil then
            Barf;
        if SkelMenu(fileMenu, @DoFileMenu, nil, true) then
            ;
        shapeMenu := GetMenu(shapeMenuRes);
        if shapeMenu = nil then
            Barf;
        if SkelHMenu(shapeMenu, @DoShapeMenu, nil) then {Install as hierarcical menu}
            ;
        CheckItem(shapeMenu, 1, true); {Check "wide"}
    end;

begin
    SkelInit(6, nil);
    SkelSetSleep(0); {Tell TransSkel that we want attention as often as possible.}
    SetupMenus;
    SetupWindow;
    InitHigh;
    InitSpriteFaces;
    InitScoreFace;
    InitPlayerFaces;
    SkelBackground(@DirtyWork);
    lastTime := TickCount;
    randSeed := TickCount;

    Synth; {Build sounds!}
    SATSoundShutup;

    SkelMain;
    SkelClobber;
    SATSoundShutup;
end.